home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / GOURAUD.INC < prev    next >
Text File  |  1987-01-05  |  5KB  |  150 lines
  1. procedure GOURAUD;
  2. { Make a surface model drawing of the object with Gouraud interpolation
  3.   of surface shading }
  4.  
  5. var Node:                      integer;       { node # }
  6.     Surf:                      integer;       { surface # }
  7.     Shade:                     real;          { shade of surface }
  8.     Shade2:                    real;          { shade of 2nd side of surface }
  9.     Vert:                      integer;       { vertex # }
  10.     Interp:                    boolean;       { flag interpolated shading }
  11. {$ifndef BIGMEM}
  12.     Shades: nodearray;
  13.       { shade at each node }
  14.     Surfmin, Surfmax: surfaces;
  15.       { surface minimum & maximum (Ztran) }
  16.     Nshades: array[1..MAXNODES] of integer;
  17.       { # shades to average per node }
  18.     Sshade: surfaces;
  19.       { shade at each surface }
  20. {$endif}
  21. label ABORTTEXT,                              { text-mode abort }
  22.       ABORTGRPH;                              { graphics-mode abort }
  23.  
  24. begin
  25. {$ifdef BIGMEM}
  26. with ptrh^ do with ptri^ do with ptrj^ do
  27. with ptra^ do with ptrb^ do with ptrc^ do
  28. with ptrd^ do with ptre^ do with ptrf^ do
  29. with ptrh^ do with ptri^ do with ptrj^ do
  30. with ptrk^ do with ptrl^ do with ptrm^ do
  31. begin
  32. {$endif}
  33.  
  34.   if (checkey) then goto ABORTTEXT;
  35. {$ifndef NOSHADOW}
  36.   if (Shadowing) then begin
  37.     shadows (Shades);
  38.     for Node := 1 to Nnodes do
  39.       Nshades[Node] := 0;
  40.   end else
  41. {$else}
  42.   if (Shadowing) then
  43.     writeln ('Error: Shadows not implemented in this version')
  44.   else
  45. {$endif}
  46.     for Node := 1 to Nnodes do begin
  47.       Shades[Node] := 0.0;
  48.       Nshades[Node] := 0;
  49.     end;
  50.  
  51.   if (Viewchanged) or (Shadowing) then begin
  52.     if (checkey) then goto ABORTTEXT;
  53.     menumsg ('Transforming to 2-D...');
  54. { Transform from 3-D to 2-D coordinates }
  55.     setorigin;
  56.     for Node := 1 to Nnodes do
  57.       perspect (Xworld[Node], Yworld[Node], Zworld[Node],
  58.                 Xtran[Node],  Ytran[Node],  Ztran[Node]);
  59.  
  60. { Set plotting limits and normalize transformed coords to screen coords }
  61.     perspect (Xfocal, Yfocal, Zfocal, Xfotran, Yfotran, Zfotran);
  62.     if (not setnormal (Xfotran, Yfotran, XYmax)) then begin
  63.       menumsg ('Warning: Focal point outside data limits.');
  64.       writeln;
  65.       write   ('  Press any key ...');
  66.       while (not keypressed) do;
  67.     { Erase the previous message }
  68.       menumsg ('');
  69.       writeln;
  70.       write ('                          ');
  71.     end;
  72.  
  73.     if (checkey) then goto ABORTTEXT;
  74. { Normalize all the nodes }
  75.     for Node := 1 to Nnodes do
  76.       normalize (Xtran[Node], Ytran[Node], Xfotran, Yfotran, XYmax);
  77.     { Initialize all nodal shades to zero }
  78.  
  79.     if (checkey) then goto ABORTTEXT;
  80.     menumsg ('Sorting surfaces...');
  81.     minmax (Surfmin, Surfmax, Nsurf);
  82.     shelsurf (Surfmin, Surfmax, Nsurf);
  83.     Viewchanged := FALSE;
  84.   end; { if Viewchanged }
  85.  
  86.   setshade;                            { Setup for shading calculations }
  87.  
  88. { Compute the cumulative shading at every node (sum the shades due to
  89.   all surrounding surfaces) }
  90.   if (checkey) then goto ABORTTEXT;
  91.   menumsg ('Computing shades...');
  92.   for Surf := 1 to Nsurf do begin
  93.     if (Nsides = 2) then begin
  94.       { Use only the side of the surface with the brightest shade }
  95.       Shade := Shading (Surf, 1);
  96.       Shade2 := Shading (Surf, 2);
  97.       if (Shade2 > Shade) then
  98.         Shade := Shade2;
  99.     end else
  100.       Shade := Shading (Surf, 1);
  101.     { Surface shade }
  102.     Sshade[Surf] := Shade;
  103.     { Nodal shade }
  104.     for Vert := 1 to Nvert[Surf] do begin
  105.       Node := konnec (Surf, Vert);
  106.       if (Shade >= 0.0) and (Shades[Node] >= 0.0) then begin
  107.         Shades[Node] := Shades[Node] + Shade;
  108.         Nshades[Node] := Nshades[Node] + 1;
  109.       end;
  110.     end; { for Vert }
  111.   end; { for Surf }
  112.  
  113.   if (checkey) then goto ABORTTEXT;
  114. { Now average out the nodal shading }
  115.   for Node := 1 to Nnodes do
  116.     if (Nshades[Node] > 0) then
  117.       Shades[Node] := Shades[Node] / Nshades[Node];
  118.  
  119. { Now plot all the surfaces, with Gouraud shading }
  120.   setgmode;
  121.   for Surf := 1 to Nsurf do begin
  122.     if (Sshade[Surf] >= 0.0) then begin
  123.       Interp := TRUE;
  124.       { If any nodal shade varies from the average (surface) shade by more
  125.         than Epsilon, then don't use interpolated shading (unless the node
  126.         is in a shadow, in which case you should interpolate anyway) }
  127.       for Vert := 1 to Nvert[Surf] do begin
  128.         Node := konnec (Surf, Vert);
  129.         if (abs(Shades[Node] - Sshade[Surf]) > Epsilon) and
  130.            (Shades[Node] >= 0.0) then
  131.           Interp := FALSE;
  132.       end;
  133.       if (Interp) then
  134.         intrfill (Surf, Color[Matl[Surf]], Shades)
  135.       else
  136.         fillsurf (Surf, Color[Matl[Surf]], Sshade[Surf]);
  137.     end; { if Sshade }
  138.     if (grafstat) then goto ABORTGRPH;
  139.   end; { for Surf }
  140.   drawaxes (Xfotran, Yfotran, XYmax);
  141. { Wait for user keypress to continue }
  142.   continue;
  143.   ABORTGRPH:
  144.   exgraphic;
  145.   ABORTTEXT:
  146. {$ifdef BIGMEM}
  147. end; {with}
  148. {$endif}
  149. end; {procedure GOURAUD }
  150.